;
; Copyright (C) 2024 The Goldfish Scheme Authors
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
; License for the specific language governing permissions and limitations
; under the License.
;

(define-library (srfi srfi-133)
(import (liii base))
(export
  vector-empty?
  vector-fold vector-fold-right
  vector-count
  vector-any vector-every vector-copy vector-copy!
  vector-index vector-index-right vector-skip vector-skip-right vector-partition
  vector-swap! vector-reverse! vector-cumulate reverse-list->vector
  vector=)
(begin

(define (vector-empty? v)
  (when (not (vector? v))
    (error 'type-error "v is not a vector"))
  (zero? (vector-length v)))

(define (vector= elt=? . rest)
  (define compare2vecs
    (typed-lambda ((cmp procedure?) (vec1 vector?) (vec2 vector?))
       (let*  ((len1 (vector-length vec1))
               (len2 (vector-length vec2)))
         (if (not (= len1 len2)) #f
             (let loop ((ilhs 0) (irhs 0) (len len1))
                  (if (= ilhs len) #t
                      (if (not (cmp (vec1 ilhs) (vec2 irhs))) #f 
                          (loop (+ 1 ilhs) (+ 1 irhs) len))))))))
  (when (not (procedure? elt=?)) (error 'type-error "elt=? should be a procedure"))
  (if (or(null? rest) (= 1 (length rest))) #t
      (let loop ((vec1 (car rest)) (vec2 (car (cdr rest))) (vrest (cdr (cdr rest))))
        (let1 rst (compare2vecs elt=? vec1 vec2)
           (when (not (boolean? rst)) (error 'type-error "elt=> should return bool"))
           (if (compare2vecs elt=? vec1 vec2)
               (if (null? vrest) #t
                   (loop vec2 (car vrest) (cdr vrest)))
               #f)))))
(define (vector-fold f initial vec)
  (let loop ((i 0) (acc initial))
    (if (< i (vector-length vec))
        (loop (+ i 1) (f (vector-ref vec i) acc))
        acc)))

(define (vector-fold-right f initial vec)
  (let loop ((i (- (vector-length vec) 1)) (acc initial))
    (if (>= i 0)
        (loop (- i 1) (f (vector-ref vec i) acc))
        acc)))

; TODO optional parameters
(define (vector-count pred v)
  (let loop ((i 0) (count 0))
       (cond ((= i (vector-length v)) count)
             ((pred (vector-ref v i)) 
              (loop (+ i 1) (+ count 1)))
             (else (loop (+ i 1) count)))))

; Return a new vector v-rst with same length of input vector vec.
; Every element of the result is the result the i-th iteration of fn cumu_i vec_i.
;   Where fn should be a procedure with 2 args.
;   The type of knil and vector could be different.
; In the i-th iteration, cumu_i = fn cumu_(i-1) vec_i, with cumu_0 = fn knil vec_0.

(define vector-cumulate
  (typed-lambda ((fn procedure?) knil (vec vector?))
    (let* ((len (vector-length vec))
           (v-rst (make-vector len)))
      (let loop ((i 0) (lhs knil))
           (if (= i len)
               v-rst
               (let1 cumu-i (fn lhs (vec i))
                 (begin
                   (vector-set! v-rst i cumu-i)
                   (loop (+ 1 i) cumu-i))))))))
; TODO optional parameters
(define (vector-any pred v)
  (let loop ((i 0))
       (cond ((= i (vector-length v)) #f)
             ((pred (vector-ref v i)) #t)
             (else (loop (+ i 1))))))

; TODO optional parameters
(define (vector-every pred v)
  (let loop ((i 0))
       (cond ((= i (vector-length v)) #t)
             ((not (pred (vector-ref v i))) #f)
             (else (loop (+ i 1))))))

(define vector-index
  (typed-lambda ((pred procedure?) (v vector?))
    (let loop ((i 0))
       (cond ((= i (vector-length v)) #f)
             ((pred (vector-ref v i)) i)
             (else (loop (+ i 1)))))))

(define vector-index-right
  (typed-lambda ((pred procedure?) (v vector?))
    (let ((len (vector-length v)))
      (let loop ((i (- len 1)))
        (cond ((< i 0) #f)
               ((pred (vector-ref v i)) i)
               (else (loop (- i 1))))))))

(define (vector-skip pred v)
  (vector-index (lambda (x) (not (pred x))) v))

(define (vector-skip-right pred v)
  (vector-index-right (lambda (x) (not (pred x))) v))

(define (vector-partition pred v)
  (let* ((len (vector-length v))
         (cnt (vector-count pred v))
         (ret (make-vector len)))
    (let loop ((i 0) (yes 0) (no cnt))
      (if (= i len)
        (values ret cnt)
        (let ((elem (vector-ref v i)))
          (if (pred elem)
            (begin
              (vector-set! ret yes elem)
              (loop (+ i 1) (+ yes 1) no))
            (begin
              (vector-set! ret no elem)
              (loop (+ i 1) yes (+ no 1)))))))))

(define (vector-swap! vec i j)
  (let ((elem-i (vector-ref vec i))
        (elem-j (vector-ref vec j)))
    (vector-set! vec i elem-j)
    (vector-set! vec j elem-i)
    ))

(define (vector-reverse! vec . args)
  (let* ((args-length (length args))
        (start (if (null? args) 0 (car args)))  
        (end  (if (<= args-length 1) 
                  (vector-length vec)          
                  (cadr args))))

      (unless (and (< args-length 3) (>= args-length 0))
        (error 'wrong-number-of-args "#<vector-reverse!>: too many args" args-length))
      (unless (and (integer? start) (integer? end))
        (error 'type-error "#<vector-reverse!>: *start* and *end* must be an integer" start end))
      (when (< start 0)
        (error 'out-of-range "#<vector-reverse!>: *start* cannot be negative" start))
      (when (> end (vector-length vec))
        (error 'out-of-range "#<vector-reverse!>: *end* exceeds vector length" end))
      (when (> start end)
        (error 'out-of-range "#<vector-reverse!>: *start* must be less than or equal to *end*" start end))
    
    (let loop ((i start) (j (- end 1)))
      (when (< i j)
        (vector-swap! vec i j)
        (loop (+ i 1) (- j 1))))))

; Input a proper-list, return a vector with inversed order elements.
(define reverse-list->vector
  (typed-lambda ((lst proper-list?))
    (let* ((len (length lst)) (v-rst (make-vector len)))
      (let loop ((l lst) (i (- len 1)))
        (if (null? l) v-rst
            (begin
              (vector-set! v-rst i (car l))
              (loop (cdr l) (- i 1))))))))

) ; end of begin
) ; end of define-library

